#lang racket

(define queen-char  "\u2655|")
(define empty-square-char "_|")
(define end-of-rank-char #\|)

(define (for-each f xs)
  (cond ((not (null? xs)) (f (car xs))
                          (for-each f (cdr xs)))))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define (flatmap proc seq)
  (accumulate append '() (map proc seq)))

(define (enumerate-interval low high)
  (if (> low high)
      '()
      (cons low (enumerate-interval (+ low 1) high))))

(define (print-rank width rank)
  (cond ((= width 0) (newline))
        ((= rank 1) (display queen-char)
                    (print-rank (- width 1) (- rank 1)))
        (else (display empty-square-char)
              (print-rank (- width 1) (- rank 1)))))

(define (sort ord seq)
  (if (null? seq)
      '()
      (let ((pivot (car seq)))
        (let ((less (lambda (x) (ord x pivot)))
              (greater (lambda (x) (not (ord x pivot)))))
          (let ((left-part (sort ord (filter less (cdr seq))))
                (right-part (sort ord (filter greater (cdr seq)))))
            (append left-part (list pivot) right-part))))))

(define (print-board board size)
  (define (print-ranks sorted-board)
    (cond ((null? sorted-board) (newline))
          (else (print-rank size (car (car sorted-board)))
                (print-board (cdr sorted-board) size))))
  (let ((sorted-by-rank (sort
                         (lambda (x y) (< (cdr x) (cdr y)))
                         board)))
    (print-ranks sorted-by-rank)))

(define empty-board '())

(define (adjoin-position file rank board)
  (let ((new-queen (cons file rank)))
    (cons new-queen board)))

(define (on-same-hor? square1 square2)
  (let ((y1 (cdr square1))
        (y2 (cdr square2)))
    (= y1 y2)))

(define (on-same-ver? square1 square2)
  (let ((x1 (car square1))
        (x2 (car square2)))
    (= x1 x2)))

(define (on-same-diag? square1 square2)
  (let ((x1 (car square1))
        (y1 (cdr square1))
        (x2 (car square2))
        (y2 (cdr square2)))
    (= (abs (- x2 x1)) (abs (- y2 y1)))))

(define (attack-each-other? q1 q2)
  (or (on-same-ver? q1 q2)
      (on-same-hor? q1 q2)
      (on-same-diag? q1 q2)))

(define (safe? k board)
  (let ((k-position (lambda (x) (= k (cdr x))))
        (other-positions (lambda (x) (not (= k (cdr x))))))
    (let ((the-queen (car (filter k-position board)))
          (other-queens (filter other-positions board)))
      (not (accumulate (lambda (x y) (or x y))
                       false
                       (map (lambda (x) (attack-each-other? the-queen x))
                            other-queens))))))

(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

(define (queens&print x)
  (for-each (lambda (y) (print-board y x)) (queens x)))

(queens&print 8)